{*
  Object Pascal simple system settings manipulation routines
  @Author  Maciej Zagozda (1998-2008)
  @Licence Microsoft Reciprocal License (Ms-RL)
  @Website http://www.codeplex.com/intelitechdelphirtns/
  @Version 2008/04/20 Added documentation support
}

{$UNDEF DELPHI5UP}
{$UNDEF DELPHI6UP}
{$UNDEF DELPHI7UP}

{$IFDEF VER130} // Delphi 5 up
 {$DEFINE DELPHI5UP}
{$ENDIF}

{$IFDEF VER140} // Delphi 6 up
 {$DEFINE DELPHI5UP}
 {$DEFINE DELPHI6UP}
{$ENDIF}

{$IFDEF VER150} // Delphi 7 up
 {$DEFINE DELPHI5UP}
 {$DEFINE DELPHI6UP}
 {$DEFINE DELPHI7UP}
{$ENDIF}

unit SystemRoutines;

interface

uses
  Classes,
  Dialogs,
  Forms,
  Messages,
  Printers,
  SysUtils,
  Registry,
  Windows;

function DAOInstalled: Boolean;

// disables windows xp system firewall service
{$IFDEF DELPHI7UP} function DisableFirewall: Boolean; {$ENDIF}

function GetComputerName: AnsiString;
function GetCurrentUser: AnsiString;
function GetCurrentUserAdministrator: Boolean;
function GetBoardBIOSName: AnsiString;
function GetBoardBIOSCopyright: AnsiString;
function GetBoardBIOSDate: AnsiString;
function GetBoardBIOSSerial: AnsiString;
function GetEnvironmentVariables(var strStrings: TStringList): Boolean;
function GetSystemUser: AnsiString;
function GetSystemCompany: AnsiString;
function GetSystemMailbox: AnsiString;
function PrinterFontInstalled( strnFontName: AnsiString ): Boolean;
function ScreenFontInstalled( strnFontName: AnsiString ): Boolean;
function TerminateProcess(ProcessId: Integer):Boolean;
function WindowsReboot: Boolean;
function WidnowsLogOff: Boolean;
function WidnowsPowerOff: Boolean;
function WidnowsReboot: Boolean;
function WindowsShutDown: Boolean;


implementation

uses
  StringRoutines;

function GetBoardBIOSName: AnsiString;
begin
  try
    Result := String(Pchar(Ptr($FE061)));
  except
    Result := 'Unsupported';
  end;
end;

//_____________________________________________________________________________

function GetBoardBIOSCopyright: AnsiString;
begin
  try
    Result := String(Pchar(Ptr($FE091)));
  except
    Result := 'Unsupported';
  end;
end;

//_____________________________________________________________________________

function GetBoardBIOSDate: AnsiString;
begin
  try
    Result := String(Pchar(Ptr($FFFF5)));
  except
    Result := 'Unsupported';
  end;
end;

//_____________________________________________________________________________

function GetBoardBIOSSerial: AnsiString;
begin
  try
    Result := String(Pchar(Ptr($FEC71)));
  except
    Result := 'Unsupported';
  end;
end;

{*
 Returns environment variables in StringList
 @param strStrings initialised StringList Object to hold environment variables
 @returns True if succesfull, False otherwise
*}

function GetEnvironmentVariables(var strStrings: TStringList): Boolean;
var
  pchVariables: PChar;
begin
  Result := True;
  try
    pchVariables := GetEnvironmentStrings;
    repeat
      strStrings.Add(StrPas(pchVariables));
      inc(pchVariables,StrLen(pchVariables)+1);
    until pchVariables^ = #0;
    FreeEnvironmentStrings(pchVariables);
  except
    Result := False;
  end;//try
end;
//_____________________________________________________________________________

function DAOInstalled: Boolean;
var
  Registry: TRegistry;
  intgResult: Byte;
begin

  intgResult := 0;
  Registry := TRegistry.Create;
  try
    Registry.RootKey := HKEY_CLASSES_ROOT;
    if Registry.OpenKeyReadOnly( 'DAO.DBEngine' ) then intgResult := Succ( intgResult );
    if Registry.OpenKeyReadOnly( 'DAO.DBEngine.35' ) then intgResult := Succ( intgResult );
    if Registry.OpenKeyReadOnly( 'DAO.DBEngine.36' ) then intgResult := Succ( intgResult );
    if Registry.OpenKeyReadOnly( 'DAO.DBEngine.40' ) then intgResult := Succ( intgResult );

    if intgResult = 0 then
    begin
      Result := False;
    end
    else
    begin
      Result := True;
    end;//if

  finally
    Registry.Free;
  end;//try
end;

{$IFDEF DELPHI7UP}
function DisableFirewall: Boolean;
var
  SCM, hService: LongWord;
  sStatus: TServiceStatus;
begin
  Result := True;
  try
    SCM := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
    hService := OpenService(SCM, PChar('SharedAccess'), SERVICE_ALL_ACCESS);

    ControlService(hService, SERVICE_CONTROL_STOP, sStatus);
    CloseServiceHandle(hService);
  except
    Result := False;
    raise;
  end;//try
end;
{$ENDIF}

//_____________________________________________________________________________

function GetComputerName: AnsiString;
var
  Registry: TRegistry;
begin
  Registry := TRegistry.Create;

  Registry.RootKey := HKEY_LOCAL_MACHINE;

  if Registry.OpenKeyReadOnly( 'SYSTEM\CurrentControlSet\Control\ComputerName\ComputerName' ) then
  begin
    Result := AnsiUpperCase( Registry.ReadString( 'ComputerName' ));
  end
  else
  begin
    Result := 'Nieznany komputer';
  end;//if

  Registry.Free;
end;

//_____________________________________________________________________________

function GetCurrentUser: AnsiString;
var
  charBuffer: array[0..128] of Char;
  strnBuffer: AnsiString;
  intgBufferSize: DWORD;
begin

  intgBufferSize := 128;
  SetLength( strnBuffer, intgBufferSize );

  if GetUserName( charBuffer, intgBufferSize ) then
  begin
    Result := StrPas( charBuffer );
  end
  else
  begin
    Result := '';
  end;//if
end;

//_____________________________________________________________________________

function GetCurrentUserAdministrator: Boolean;
const
  SECURITY_NT_AUTHORITY: TSIDIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 5));
  SECURITY_BUILTIN_DOMAIN_RID = $00000020;
  DOMAIN_ALIAS_RID_ADMINS = $00000220;
  ENGINE_ID = 1;
  INDEX_SERVER_ID = 2;
  STOP_LISTS_ID = 21;
  NEUTRAL_STOP_LIST_ID = 211;
  ENGLISH_STOP_LIST_ID = 212;
  MORPHOLOGY_ID = 3;
  SOUNDEX_ID = 4;
  THESAURUS_ID = 5;
  THES_PROJ_ID = 51;
  THES_DIC_ID = 52;
  LOGIN_ID = 6;
  FILTER_ID = 7;
  THES_DIC_OFFSET = 10000;
var
  hAccessToken: THandle;
  ptgGroups: PTokenGroups;
  dwInfoBufferSize: DWORD;
  psidAdministrators: PSID;
  x: Integer;
  bSuccess: BOOL;
begin

  Result := False;

  bSuccess := OpenThreadToken(GetCurrentThread, TOKEN_QUERY, True, hAccessToken);
  if not bSuccess then
  begin
    if GetLastError = ERROR_NO_TOKEN then
    begin
      bSuccess := OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, hAccessToken);
    end;//if
  end;//if

  if bSuccess then
  begin
    GetMem(ptgGroups, 1024);
    bSuccess := GetTokenInformation(hAccessToken, TokenGroups, ptgGroups, 1024, dwInfoBufferSize);
    CloseHandle(hAccessToken);

    if bSuccess then
    begin
      AllocateAndInitializeSid( SECURITY_NT_AUTHORITY, 2, SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_ADMINS, 0, 0, 0, 0, 0, 0, psidAdministrators);

      {$R-}
      for x := 0 to ptgGroups.GroupCount - 1 do
      begin
        if EqualSid(psidAdministrators, ptgGroups.Groups[x].Sid) then
        begin
          Result := True;
          Break;
        end;//if
      end;//for
      {$R+}

      FreeSid(psidAdministrators);
    end;//if

    FreeMem(ptgGroups);
  end;
end;

//_____________________________________________________________________________

function GetSystemUser: AnsiString;
const
  strnKey = 'RegisteredOwner';
var
  Registry: TRegistry;
begin

  Result := 'Nieznana organizacja';
  Registry := TRegistry.Create;
  try
    Registry.RootKey := HKEY_LOCAL_MACHINE;

    if Registry.OpenKeyReadOnly( 'Software\Microsoft\Windows NT\CurrentVersion' ) then
    begin
      if Registry.ValueExists( strnKey ) then Result := Registry.ReadString( strnKey );
    end;//if

    if Registry.OpenKeyReadOnly( 'Software\Microsoft\Windows\CurrentVersion' ) then
    begin
      if Registry.ValueExists( strnKey ) then Result := Registry.ReadString( strnKey );
    end;//if

  finally
    Registry.Free;
  end;//try

end;

//_____________________________________________________________________________

function GetSystemCompany: AnsiString;
const
  strnKey = 'RegisteredOrganization';
var
  Registry: TRegistry;
begin
  Result := 'Nieznana organizacja';
  Registry := TRegistry.Create;
  try
    Registry.RootKey := HKEY_LOCAL_MACHINE;

    if Registry.OpenKeyReadOnly( 'Software\Microsoft\Windows NT\CurrentVersion' ) then
    begin
      if Registry.ValueExists( strnKey ) then Result := Registry.ReadString( strnKey );
    end;//if

    if Registry.OpenKeyReadOnly( 'Software\Microsoft\Windows\CurrentVersion' ) then
    begin
      if Registry.ValueExists( strnKey ) then Result := Registry.ReadString( strnKey );
    end;//if

  finally
    Registry.Free;
  end;//try
end;

//_____________________________________________________________________________

function GetSystemMailbox: AnsiString;
const
  strnKey = 'SMTP Email Address';
var
  Registry: TRegistry;
  strnSubKey: AnsiString;
  intgA: Integer;
begin
  Result := '';
  Registry := TRegistry.Create;
  try
    Registry.RootKey := HKEY_CURRENT_USER;

    for intgA := 1 to 10 do
    begin
      strnSubKey := PadString( IntToStr( intgA ), 8 );
      if Registry.OpenKeyReadOnly( 'Software\Microsoft\Internet Account Manager\Accounts\' + strnSubKey ) then
      begin
        if Registry.ValueExists( strnKey ) then
        begin
          Result := Registry.ReadString( strnKey );
          Break;
        end;//if
      end;//if
    end;//for

  finally
    Registry.Free;
  end;//try
end;

function GetSystemVariables(var strStrings: TStringList): Boolean;
var
  pchVariables: PChar;
begin
  Result := True;
  try
    pchVariables := GetEnvironmentStrings;
    repeat
     strStrings.Add(StrPas(pchVariables));
     inc(pchVariables,StrLen(pchVariables)+1);
    until pchVariables^=#0;
    FreeEnvironmentStrings(pchVariables);
  except
    Result := False;
  end;//try
end;

//_____________________________________________________________________________

function PrinterFontInstalled( strnFontName: AnsiString ): Boolean;
begin
  Result := Printer.Fonts.IndexOf( strnFontName ) > -1;
end;

//_____________________________________________________________________________

function ScreenFontInstalled( strnFontName: AnsiString ): Boolean;
begin
  Result := Screen.Fonts.IndexOf( strnFontName ) > -1;
end;

function TerminateProcess(ProcessId: Integer):Boolean;
var
  hndDefault: THandle;
begin
  hndDefault := OpenProcess(PROCESS_TERMINATE, Bool(0), ProcessId);
  if TerminateProcess(hndDefault) then result:=true else result:=false;
  CloseHandle(hndDefault);
end;

function WindowsReboot: Boolean;
begin
  Result := True;
  ExitWindowsEx(EWX_REBOOT,0);
end;

function WidnowsLogOff: Boolean;
begin
  Result := True;
  ExitWindowsEx(EWX_LOGOFF,0);
end;

function WidnowsPowerOff: Boolean;
begin
  Result := True;
  ExitWindowsEx(EWX_POWEROFF,0);
end;

function WidnowsReboot: Boolean;
begin
  Result := True;
  ExitWindowsEx(EWX_REBOOT,0);
end;

function WindowsShutDown: Boolean;
begin
  Result := True;
  ExitWindowsEx(EWX_SHUTDOWN,0);
end;

end.
